home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / pb3brows.zip / VID&KBD.BAS < prev   
BASIC Source File  |  1993-04-03  |  5KB  |  164 lines
  1. '******************************************************************************
  2. '*                 Module met enkele Powerbasic 3 routines                    *
  3. '*                       voor video en toetsenbord                            *
  4. '*                      (c) Hans Lunsing - 04/1993                            *
  5. '******************************************************************************
  6.  
  7. $DIM ARRAY
  8. $ERROR ALL -
  9. $LIB LPT -, COM -, GRAPH -, FULLFLOAT -, IPRINT -
  10. $OPTIMIZE SIZE
  11. $OPTION CNTLBREAK -, GOSUB -
  12. $STRING 1
  13.  
  14. DEFINT A-Z
  15.  
  16. 'Absolute adressen:
  17. %AddressOffs = &H44E    'Video current page start address in regen buffer
  18. %AddressPort = &H463    'Video CRT controller base address:
  19.             'color=03D4h, mono=03B4h
  20. %ModeSetting = &H465    'Video current setting of mode select register
  21.             '03D8h/03B8h
  22.  
  23. 'Videopoorten:
  24. ' 3B0 - 3BFh  monochrome
  25. ' 3C0 - 3CFh  EGA (primary)
  26. ' 3D0 - 3DFh  CGA
  27. %MonoPorts = &H3BF    'highest portnumber for monochrome monitors
  28. %MonoSeg = &HB000
  29. %ColorSeg = &HB800
  30.  
  31. $INCLUDE "GENERAL.BI"
  32.  
  33. SUB Attr (BYVAL Fore, BYVAL Back) PUBLIC
  34.   COLOR (Fore + 2 * (Back AND 8)), (Back AND 7)
  35. END SUB
  36.  
  37. FUNCTION BlinkStatus PUBLIC
  38.   ' Function: returns blinkbit status of textcolor
  39.   DEF SEG = &H0
  40.   BlinkStatus = ((PEEK(%ModeSetting) AND &H20) = &H20)
  41.   DEF SEG
  42. END FUNCTION
  43.  
  44. SUB ClearLines (BYVAL Top, BYVAL Bottom) PUBLIC
  45.   VIEW TEXT (1,Top) - (pbvScrnCols,Bottom)
  46.   CLS TEXT
  47.   VIEW TEXT (1,1) - (pbvScrnCols,pbvScrnRows)
  48. END SUB
  49.  
  50. FUNCTION GetActiveColor PUBLIC
  51.   ' Function: gets active screen color for DOS
  52.   REG %DX, &H20
  53.   REG %AX, &H200
  54.   CALL INTERRUPT &H21            'Put space on screen via DOS
  55.   REG %AX, &HF00
  56.   CALL INTERRUPT &H10            'Get videopage in BH
  57.   REG %AX, &HE08
  58.   CALL INTERRUPT &H10            'backspace Whiteh videointerrupt 10
  59.   REG %AX, &H800
  60.   CALL INTERRUPT &H10            'get attribute at cursor
  61.   GetActiveColor = REG(%AX) \ 256
  62. END FUNCTION
  63.  
  64. SUB GetAttr (Fore, Back) PUBLIC
  65.   Fore = (pbvScrnTtxtAttr AND &HF)
  66.   Back = (pbvScrnTtxtAttr AND &HF0)
  67.   SHIFT RIGHT Back, 4
  68. END SUB
  69.  
  70. FUNCTION GetKey PUBLIC
  71.   DO: LOOP UNTIL INSTAT
  72.   GetKey = MakeKey (INKEY$)
  73. END FUNCTION
  74.  
  75. SUB GetVideoAddress (VideoSeg, VideoOffs) PUBLIC
  76.   DEF SEG = 0
  77.   IF PEEKI(%AddressPort) = %MonoPorts THEN
  78.     VideoSeg = %MonoSeg
  79.   ELSE
  80.     VideoSeg = %ColorSeg
  81.   END IF
  82.   VideoOffs = PEEKI(%AddressOffs)
  83.   DEF SEG
  84. END SUB
  85.  
  86. FUNCTION GetVideoMode PUBLIC
  87.   'Function: gets active videomode according to BIOS
  88.   REG %AX, &HF00
  89.   CALL INTERRUPT &H10
  90.   GetVideoMode = (REG(%AX) AND &HFF)    'VideoMode in AL
  91. END FUNCTION
  92.  
  93. SUB InvertColor (BYVAL Fore, BYVAL Back, InverseFore, InverseBack) PUBLIC
  94.   'Attributes Whiteh monochrome textmode
  95.   '(NORTON's programmers guide to the IBM PC):
  96.  
  97.   'BLINKING ENABLED:
  98.   'Normal      Betekenis                                inverse chosen:
  99.   'Fore Back   Foreground           Backgroundgrond        Fore Back
  100.   '  0    0    Black                Black                -    -
  101.   '  1    0    White underlined     Black                0    7
  102.   '  7    0    White                Black                0    7
  103.   '  9    0    BrightWhite underld  Black               0    7
  104.   ' 15    0    BrightWhite          Black             0    7
  105.   '  0    7    Black                White                  7    0
  106.   '  7    8    blinking White       Black    1)       0   15
  107.   ' 15    8    blinking BrhtWhite   Black    1)       0   15
  108.   '  0   15    blinking Black       White                  7    8
  109.  
  110.   'BLINKING DISABLED:
  111.   'Normal
  112.   'Fore Back   Foreground            Background    Fore Back
  113.   '  0    0    Black                 Black            -    -
  114.   '  1    0    White underlined      Black            0    7
  115.   '  7    0    White                 Black            0    7
  116.   '  9    0    BrghtWhite underld    Black            0   15
  117.   ' 15    0    BrightWhite           Black            0   15
  118.   '  0    7    Black                 White            7    0
  119.   '  7    8    White                 grey       1)    0    7
  120.   ' 15    8    BrightWhite           grey       1)    0   15
  121.   '  0   15    Black                 BrightWhite     15    0
  122.  
  123.   ' 1) Not on all monochrome monitoren
  124.  
  125.   IF BlinkStatus THEN
  126.     IF GetVideoMode = 7 THEN
  127.       InverseFore = (Back AND 7)
  128.       InverseBack = (InverseFore XOR 7) + (Back AND 8)
  129.     ELSE
  130.       'Als het hoogste kleurbit de betekenis blinkinge tekst heeft
  131.       'worden alleen de laagste drie bits van elke kleur geinverteerd.
  132.       'Bit 3 (helderheid voorgrond) en bit 7 (knipperen voorgrond)
  133.       'blijven staan.
  134.       InverseFore = (Back AND 7) + (Fore AND 8)
  135.       InverseBack = (Fore AND 7) + (Back AND 8)
  136.     END IF
  137.   ELSE
  138.     IF GetVideoMode = 7 THEN
  139.       InverseFore = (Back AND 7) - ((Back AND 7) <> 0) * (Back AND 8)
  140.       InverseBack = ((InverseFore AND 7) XOR 7) + (Fore AND 8)
  141.     ELSE
  142.       InverseFore = Back
  143.       InverseBack = Fore
  144.     END IF
  145.   END IF
  146. END SUB
  147.  
  148. FUNCTION MakeChar$ (BYVAL Toets) PUBLIC
  149.   IF Toets >= 0 THEN
  150.     MakeChar$ = CHR$(Toets)
  151.   ELSE
  152.     MakeChar$ = CHR$(0) + CHR$(-Toets)
  153.   END IF
  154. END FUNCTION
  155.  
  156. FUNCTION MakeKey (Char$) PUBLIC
  157.   IF LEN(Char$) = 1 THEN
  158.     MakeKey = ASCII(Char$)
  159.   ELSE
  160.     MakeKey = - ASCII(RIGHT$(Char$, 1))
  161.   END IF
  162. END FUNCTION
  163.  
  164.